home *** CD-ROM | disk | FTP | other *** search
/ Interplay's Learn to Program Basic (Review Copy) / Learn to Program Basic Review Copy (Interplay)(June 23, 1998).ISO / pc / ltpbasic / projects / wrdsrch.bas < prev   
Encoding:
BASIC Source File  |  1998-03-02  |  9.5 KB  |  468 lines
  1. Rem Word Search
  2. Rem By Steven Ohmert
  3.  
  4. CLS
  5.  
  6. Rem Define constants
  7. Level = 1
  8. allowReverse = FALSE
  9.  
  10. Rem How many words?
  11. totalWords = 30 ' number of words in Data statements
  12. wordsToFind = 5 ' number we try to find each game
  13.  
  14. Rem Get level settings from user
  15. Gosub Setup
  16.  
  17. Rem Set up difficulties per level
  18. if Level = 1 Then columns = 15
  19. if Level = 2 Then columns = 17
  20. if Level = 3 Then columns = 20
  21. if Level = 4 Then columns = 23
  22. if Level = 5 Then columns = 26
  23. rows = int(columns / 2)
  24. listColumn = columns + 3
  25. listRow = 0 
  26.  
  27. Dim Grid$(columns,rows)
  28. Dim GridColor(columns,rows)
  29. Dim WordList$(totalWords)
  30. Dim Words$(wordsToFind)
  31. Dim WordStart(wordsToFind)
  32. Dim WordStop(wordsToFind)
  33. Dim WordMethod(wordsToFind)
  34.  
  35. StartGame:
  36. Rem Start off clean
  37. numberSolved = 0
  38.  
  39. Rem Clear the grid
  40. for r = 1 to rows
  41. for c = 1 to columns
  42. Grid$(c,r) = ""
  43. GridColor(c,r) = 21
  44. next
  45. next
  46.  
  47. Rem Get all of the words into an array
  48. for i = 1 to totalWords
  49. Read WordList$(i)
  50. Next i
  51.  
  52. Rem Get the words for this game
  53. for i = 1 to wordsToFind
  54. gotWord = FALSE
  55. while gotWord = FALSE
  56. w = Random(1,totalWords)
  57. if WordList$(w) <> "" then gotWord = TRUE
  58. wend
  59. Rem add word to our list, then clear it 
  60. Rem from list of available words
  61. Words$(i) = WordList$(w)
  62. WordList$(w) = ""
  63. next
  64.  
  65. Rem For each word, find a place for it
  66. For currentWord = 1 to wordsToFind
  67.  
  68. Fit = FALSE
  69. While Fit = FALSE
  70. Rem find an open starting spot
  71. letter$ = "*"
  72. while letter$ <> ""
  73. col = random(1,columns)
  74. row = random(1,rows)
  75. letter$ = grid$(col,row)
  76. wend
  77.  
  78. method = Random(1,4)
  79. if method = 1 then Gosub HFitWord
  80. if method = 2 then Gosub VFitWord
  81. if method = 3 then Gosub DDFitWord
  82. if method = 4 then Gosub DUFitWord
  83.  
  84. wordStart(currentWord) = row * columns + col
  85. wordMethod(currentWord) = method
  86. if method <> 2 Then col = col + wLen-1
  87. if method <> 1 AND method <> 4 Then row = row + wLen-1
  88. if method = 4 Then row = row - (wLen-1)
  89. wordStop(currentWord) = row * columns + col
  90.  
  91. Wend
  92. Next
  93.  
  94. REM Now, set the unused areas to random letters
  95. for row = 1 to rows
  96. for col = 1 to columns
  97. if Grid$(col,row) = "" Then 
  98. Grid$(col,row) = chr$(random(65,90))
  99. 'Grid$(col,row) = "."
  100. Endif
  101. Next
  102. Next
  103.  
  104.  
  105. REM OKAY! We've made our grid! Print it out!
  106. CLS
  107. Gosub PrintGrid
  108.  
  109. Rem Now print out the word list
  110. TextColor 66 'Feelin' Blue
  111. for i = 1 to wordsToFind
  112. position listColumn,i-1+listRow
  113. print Words$(i);
  114. next
  115.  
  116. firstClickedCol = 0
  117. firstClickedRow = 0
  118.  
  119. Rem get the user click, and see if we clicked on a word or not
  120. while numberSolved < wordsToFind
  121. clickedRow = 0
  122. clickedCol = 0
  123. while clickedRow = 0 OR clickedCol = 0 
  124. Gosub GetGridClick
  125. wend
  126.  
  127. Rem Undo any previous 'first click' that is left over
  128. If firstClickedCol > 0 and firstClickedRow > 0 then
  129. TextColor GridColor(firstClickedCol,firstClickedRow)
  130. Position firstClickedCol-1,firstClickedRow-1
  131. Print Grid$(firstClickedCol,firstClickedRow);
  132. Endif
  133. Rem Make the letter we click on Green
  134. TextColor 156 'Soylent Green
  135. Position clickedCol-1,clickedRow-1
  136. Print Grid$(clickedCol,clickedRow);
  137. Rem remember this so we can undo it later
  138. firstClickedCol = clickedCol
  139. firstClickedRow = clickedRow
  140.  
  141. sq = clickedRow * columns + clickedCol
  142.  
  143. Rem look for start of word in list
  144. foundWord = 0
  145. reverse = FALSE
  146. for i = 1 to wordsToFind
  147. if wordStart(i) = sq then
  148. foundWord = i
  149. Endif
  150. Next
  151.  
  152. Rem look for end of word in list
  153. if foundWord = 0 Then
  154. for i = 1 to wordsToFind
  155. if wordStop(i) = sq then
  156. foundWord = i
  157. reverse = TRUE
  158. EndIf
  159. Next
  160. Endif
  161.  
  162. if foundWord Then
  163. startCol = wordStart(foundWord) Mod columns
  164. startRow = Int(wordStart(foundWord) / columns)
  165. endCol = wordStop(foundWord) Mod columns
  166. endRow = Int(wordStop(foundWord) / columns)
  167. length = Len(Words$(foundWord))
  168. if wordMethod(foundWord) <> 2 Then endCol = clickedCol + length-1
  169. if wordMethod(foundWord) <> 1 AND wordMethod(foundWord) <> 4 Then endRow = clickedRow + length-1
  170. if wordMethod(foundWord) = 4 Then endRow = clickedRow - length +1
  171.  
  172. clickedRow = 0
  173. clickedCol = 0
  174. while clickedRow = 0 OR clickedCol = 0 
  175. Gosub GetGridClick
  176. wend
  177.  
  178. firstClickedCol = clickedCol
  179. firstClickedRow = clickedRow
  180.  
  181. Rem if we clicked on the end first, let's reverse our expectations
  182. if reverse then
  183. endRow = startRow
  184. endCol = startCol
  185. Endif
  186.  
  187. if clickedRow = endRow AND clickedCol = endCol Then
  188. Sound "Whiz"
  189. Rem 'walk' along the word according to it's placement method
  190. Rem and redraw all the letters in red
  191. TextColor 94
  192. for i = 1 to length
  193. GridColor(startCol,startRow) = 94
  194. Position startCol-1,startRow-1
  195. Print Grid$(startCol,startRow);
  196. if wordMethod(foundWord) <> 2 then startCol = startCol + 1
  197. if wordMethod(foundWord) <> 1 AND wordMethod(foundWord) <> 4 then startRow = startRow + 1
  198. if wordMethod(foundWord) = 4 then startRow = startRow - 1
  199. next
  200. numberSolved = numberSolved + 1
  201.  
  202. firstClickedCol = 0
  203. firstClickedRow = 0
  204.  
  205. Rem cross off the word from the list
  206. x1 = listColumn * 8 + 4
  207. x2 = (listColumn + Len(words$(foundWord))) * 8 - 4
  208. y = (listRow+foundWord-1) * 16 + 8
  209. Color 157 
  210. for i = 0 to 2
  211. Line x1,y+i to x2,y+i
  212. next
  213. Rem 'remove' word from word list so that we can't choose it
  214. Rem more than once!
  215.  
  216. Endif
  217.  
  218. Endif
  219. Wend
  220.  
  221. TextColor 204 
  222. Position 0,13
  223. Print "Congratulations! You got them all!";
  224. Sleep 35
  225. End
  226.  
  227.  
  228. REM See if we can fit a word horizontally
  229. HFitWord:
  230.  
  231. Rem first, see if it will fit
  232. wLen = Len(Words$(currentWord))
  233. wLeft = columns - col
  234. if wLen <= wLeft Then
  235. w$ = Words$(currentWord)
  236. Fit = TRUE
  237. if allowReverse = TRUE And Random(1,100) > 50 Then
  238. Rem try to fit the word backwards
  239. for i = 0 to wLen-1
  240. IF Grid$(col+i,row) <> "" AND Grid$(col+i,row) <> Mid$(w$,wLen-i,1) THEN
  241. Goto TryForward
  242. EndIf
  243. Next
  244. Rem it fits: Record the word
  245. Fit = TRUE
  246. For i = 0 to wLen-1
  247. Grid$(col+i,row) = Mid$(w$,wLen-i,1)
  248. Next
  249. Return
  250. else
  251. TryForward:
  252. for i = 0 to wLen-1
  253. IF Grid$(col+i,row) <> "" AND Grid$(col+i,row) <> Mid$(w$,i+1,1) THEN
  254.  Goto HFail
  255. EndIf
  256. Next
  257. Rem it fits: record the word
  258. Fit = TRUE
  259. for i = 0 to wLen-1
  260. Grid$(col+i,row) = Mid$(w$,i+1,1)
  261. Next
  262. Return
  263. EndIf
  264. Endif
  265.  
  266. Rem Failed to fit word horizontally at this location
  267. HFail:
  268. Fit = FALSE
  269. Return
  270.  
  271. REM See if we can fit a word vertically
  272. VFitWord:
  273. Rem first, see if it will fit
  274. wLen = Len(Words$(currentWord))
  275. wLeft = rows - row
  276. if wLen <= wLeft Then
  277. w$ = Words$(currentWord)
  278. Fit = TRUE
  279. if allowReverse = TRUE And Random(1,100) > 50 Then
  280. Rem try to fit the word backwards
  281. for i = 0 to wLen-1
  282. IF Grid$(col,row+i) <> "" AND Grid$(col,row+i) <> Mid$(w$,wLen-i,1) THEN
  283. Goto TryForward2
  284. EndIf
  285. Next
  286. Rem it fits: Record the word
  287. Fit = TRUE
  288. For i = 0 to wLen-1
  289. Grid$(col,row+i) = Mid$(w$,wLen-i,1)
  290. Next
  291. Return
  292. else
  293. TryForward2:
  294. for i = 0 to wLen-1
  295. IF Grid$(col,row+i) <> "" AND Grid$(col,row+i) <> Mid$(w$,i+1,1) THEN
  296.  Goto VFail
  297. EndIf
  298. Next
  299. Rem it fits: record the word
  300. Fit = TRUE
  301. for i = 0 to wLen-1
  302. Grid$(col,row+i) = Mid$(w$,i+1,1)
  303. Next
  304. Return
  305. EndIf
  306. Endif
  307.  
  308. Rem Failed to fit word vertically at this location
  309. VFail:
  310. Fit = FALSE
  311. Return
  312.  
  313. REM See if we can fit a word diagonally, down
  314. DDFitWord:
  315. Rem first, see if it will fit
  316. wLen = Len(Words$(currentWord))
  317. wLeftH = columns - col
  318. wLeftV = rows - row
  319. wLeft = wLeftV
  320. if wLeftV > wLeftH Then wLeft = wLeftH
  321. if wLen <= wLeft Then
  322. w$ = Words$(currentWord)
  323. Fit = TRUE
  324. if allowReverse = TRUE And Random(1,100) > 50 Then
  325. Rem try to fit the word backwards
  326. for i = 0 to wLen-1
  327. IF Grid$(col+i,row+i) <> "" AND Grid$(col+i,row+i) <> Mid$(w$,wLen-i,1) THEN
  328. Goto TryForward3
  329. EndIf
  330. Next
  331. Rem it fits: Record the word
  332. Fit = TRUE
  333. For i = 0 to wLen-1
  334. Grid$(col+i,row+i) = Mid$(w$,wLen-i,1)
  335. Next
  336. Return
  337. else
  338. TryForward3:
  339. for i = 0 to wLen-1
  340. IF Grid$(col+i,row+i) <> "" AND Grid$(col+i,row+i) <> Mid$(w$,i+1,1) THEN
  341.  Goto DDFail
  342. EndIf
  343. Next
  344. Rem it fits: record the word
  345. Fit = TRUE
  346. for i = 0 to wLen-1
  347. Grid$(col+i,row+i) = Mid$(w$,i+1,1)
  348. Next
  349. Return
  350. EndIf
  351. Endif
  352.  
  353. Rem Failed to fit word diagonally at this location
  354. DDFail:
  355. Fit = FALSE
  356. Return
  357.  
  358. REM See if we can fit a word diagonally, up
  359. DUFitWord:
  360. Rem first, see if it will fit
  361. wLen = Len(Words$(currentWord))
  362. wLeftH = columns - col
  363. wLeftV = row
  364. wLeft = wLeftV
  365. if wLeftV > wLeftH Then wLeft = wLeftH
  366. if wLen <= wLeft Then
  367. w$ = Words$(currentWord)
  368. Fit = TRUE
  369. if allowReverse = TRUE And Random(1,100) > 50 Then
  370. Rem try to fit the word backwards
  371. for i = 0 to wLen-1
  372. IF Grid$(col+i,row-i) <> "" AND Grid$(col+i,row-i) <> Mid$(w$,wLen-i,1) THEN
  373. Goto TryForward4
  374. EndIf
  375. Next
  376. Rem it fits: Record the word
  377. Fit = TRUE
  378. For i = 0 to wLen-1
  379. Grid$(col+i,row-i) = Mid$(w$,wLen-i,1)
  380. Next
  381. Return
  382. else
  383. TryForward4:
  384. for i = 0 to wLen-1
  385. IF Grid$(col+i,row-i) <> "" AND Grid$(col+i,row-i) <> Mid$(w$,i+1,1) THEN
  386.  Goto DUFail
  387. EndIf
  388. Next
  389. Rem it fits: record the word
  390. Fit = TRUE
  391. for i = 0 to wLen-1
  392. Grid$(col+i,row-i) = Mid$(w$,i+1,1)
  393. Next
  394. Return
  395. EndIf
  396. Endif
  397.  
  398. Rem Failed to fit word diagonally at this location
  399. DUFail:
  400. Fit = FALSE
  401. Return
  402.  
  403. Rem Get the character clicked on by the user
  404. GetGridClick:
  405. clickedRow = 0
  406. clickedCol = 0
  407. for r = 0 to rows-1
  408. for c = 0 to columns-1
  409. if ClickRect(c*8,r*16 to c*8+7,r*16+15) Then
  410. clickedRow = r+1
  411. clickedCol = c+1
  412. return
  413. EndIf
  414. Next
  415. Next
  416. Return
  417.  
  418. Rem Print out the grid
  419. PrintGrid:
  420. home
  421. For row = 1 to rows
  422. For col = 1 to columns
  423. TextColor GridColor(col,row)
  424. print Grid$(col,row);
  425. Next
  426. Print
  427. next
  428. Return
  429.  
  430.  
  431. REM Title and setup
  432. Setup:
  433. CLS
  434. TextColor 21
  435. Print " W"
  436. Print "  O"
  437. Print "SEARCH"
  438. Print "    D"
  439. Print
  440. Print "By Steven Ohmert"
  441. Print
  442. Level = 0
  443. Position 0,10
  444. Print "Choose Level of Difficulty (1-5) "
  445. while Level < 1 OR Level > 5
  446. Position 33,10
  447. Input Level
  448. Wend
  449. Print "Allow words to go backwards? (Y/N) "
  450. a$ = ""
  451. while a$ <> "N" AND a$ <> "Y"
  452. a$ = upper$(inkey$)
  453. wend
  454. if a$ = "Y" then allowReverse = TRUE
  455. Return
  456.  
  457. Rem Data of words in the program
  458. Data BASIC,APPLE,PEACH,COMPUTER,TRICYCLE
  459. Data TORNADO,GARBAGE,SUNSHINE,PRETTY,MEDIA
  460. Data EXPERIMENT,TECHNIQUE,CHALLENGE,ACTIVE,SPEECH
  461. Data TRADITION,COFFEE,MEMORY,STANDING,ORANGE
  462. Data DRAMA,FOUNDATION,LISTEN,NATURAL,WATER
  463. Data SUPPORT,TYRANNY,DINOSAUR,COBRA,PUPPY
  464.  
  465.  
  466.  
  467.